unit mGraphics;
// License is LGPL. Includes parts of FreePascal+Lazarus FCL+LCL (mostly
// types and consts)
{$i mPlatform.inc}
interface

uses
  Classes, SysUtils, AdUtils, mSets;
type
  THandle=LongInt;
  TColor = LongInt;
  TFontStyle = (fsBold, fsItalic, fsStrikeOut, fsUnderline);
  TFontStyles = set of TFontStyle;
  TPenStyle = (psSolid, psDash, psDot, psDashDot, psDashDotDot, psInsideFrame, psPattern, psClear);
  TPenStyles = set of TPenStyle;
  TBrushStyle = (bsSolid, bsClear, bsHorizontal, bsVertical, bsFDiagonal,
                 bsBDiagonal, bsCross, bsDiagCross, bsImage, bsPattern);
  TPenMode = (pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy,
                pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge,
                pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor);
{$ifdef virtualpascal}
const //from FCL/LCL
{$else}
var
{$endif}
  clBlack:TColor    = TColor($000000);
  clMaroon:TColor   = TColor($000080);
  clGreen:TColor    = TColor($008000);
  clOlive:TColor    = TColor($008080);
  clNavy:TColor     = TColor($800000);
  clPurple:TColor   = TColor($800080);
  clTeal:TColor     = TColor($808000);
  clGray:TColor     = TColor($808080);
  clSilver:TColor   = TColor($C0C0C0);
  clRed:TColor      = TColor($0000FF);
  clLime:TColor     = TColor($00FF00);
  clYellow:TColor   = TColor($00FFFF);
  clBlue:TColor     = TColor($FF0000);
  clFuchsia:TColor  = TColor($FF00FF);
  clAqua:TColor     = TColor($FFFF00);
  clLtGray:TColor   = TColor($C0C0C0);
  clDkGray:TColor   = TColor($808080);
  clWhite:TColor    = TColor($FFFFFF);
const //todo:What is this?
  COLOR_SCROLLBAR = 0;
  COLOR_BACKGROUND = 1;
  COLOR_ACTIVECAPTION = 2;
  COLOR_INACTIVECAPTION = 3;
  COLOR_MENU = 4;
  COLOR_WINDOW = 5;
  COLOR_WINDOWFRAME = 6;
  COLOR_MENUTEXT = 7;
  COLOR_WINDOWTEXT = 8;
  COLOR_CAPTIONTEXT = 9;
  COLOR_ACTIVEBORDER = 10;
  COLOR_INACTIVEBORDER = 11;
  COLOR_APPWORKSPACE = 12;
  COLOR_HIGHLIGHT = 13;
  COLOR_HIGHLIGHTTEXT = 14;
  COLOR_BTNFACE = 15;
  COLOR_BTNSHADOW = 16;
  COLOR_GRAYTEXT = 17;
  COLOR_BTNTEXT = 18;
  COLOR_INACTIVECAPTIONTEXT = 19;
  COLOR_BTNHIGHLIGHT = 20;
  COLOR_3DDKSHADOW = 21;
  COLOR_3DLIGHT = 22;
  COLOR_INFOTEXT = 23;
  COLOR_INFOBK = 24;
  SYS_COLOR_BASE = TColor($80000000);

  clScrollBar               = TColor(SYS_COLOR_BASE or COLOR_SCROLLBAR);
  clBackground              = TColor(SYS_COLOR_BASE or COLOR_BACKGROUND);
  clActiveCaption           = TColor(SYS_COLOR_BASE or COLOR_ACTIVECAPTION);
  clInactiveCaption         = TColor(SYS_COLOR_BASE or COLOR_INACTIVECAPTION);
  clMenu                    = TColor(SYS_COLOR_BASE or COLOR_MENU);
  clWindow                  = TColor(SYS_COLOR_BASE or COLOR_WINDOW);
  clWindowFrame             = TColor(SYS_COLOR_BASE or COLOR_WINDOWFRAME);
  clMenuText                = TColor(SYS_COLOR_BASE or COLOR_MENUTEXT);
  clWindowText              = TColor(SYS_COLOR_BASE or COLOR_WINDOWTEXT);
  clCaptionText             = TColor(SYS_COLOR_BASE or COLOR_CAPTIONTEXT);
  clActiveBorder            = TColor(SYS_COLOR_BASE or COLOR_ACTIVEBORDER);
  clInactiveBorder          = TColor(SYS_COLOR_BASE or COLOR_INACTIVEBORDER);
  clAppWorkspace            = TColor(SYS_COLOR_BASE or COLOR_APPWORKSPACE);
  clHighlight               = TColor(SYS_COLOR_BASE or COLOR_HIGHLIGHT);
  clHighlightText           = TColor(SYS_COLOR_BASE or COLOR_HIGHLIGHTTEXT);
  clBtnFace                 = TColor(SYS_COLOR_BASE or COLOR_BTNFACE);
  clBtnShadow               = TColor(SYS_COLOR_BASE or COLOR_BTNSHADOW);
  clGrayText                = TColor(SYS_COLOR_BASE or COLOR_GRAYTEXT);
  clBtnText                 = TColor(SYS_COLOR_BASE or COLOR_BTNTEXT);
  clInactiveCaptionText     = TColor(SYS_COLOR_BASE or COLOR_INACTIVECAPTIONTEXT);
  clBtnHighlight            = TColor(SYS_COLOR_BASE or COLOR_BTNHIGHLIGHT);
  cl3DDkShadow              = TColor(SYS_COLOR_BASE or COLOR_3DDKSHADOW);
  cl3DLight                 = TColor(SYS_COLOR_BASE or COLOR_3DLIGHT);
  clInfoText                = TColor(SYS_COLOR_BASE or COLOR_INFOTEXT);
  clInfoBk                  = TColor(SYS_COLOR_BASE or COLOR_INFOBK);

const
//charsets
ANSI_CHARSET        = 0;
  DEFAULT_CHARSET     = 1;
  SYMBOL_CHARSET      = 2;
  //todo: do we need them?
  FCS_ISO_10646_1     = 4;  // Unicode;
  FCS_ISO_8859_1      = 5;  //  ISO Latin-1 (Western Europe);
  FCS_ISO_8859_2      = 6;  //  ISO Latin-2 (Eastern Europe);
  FCS_ISO_8859_3      = 7;  //  ISO Latin-3 (Southern Europe);
  FCS_ISO_8859_4      = 8;  //  ISO Latin-4 (Northern Europe);
  FCS_ISO_8859_5      = 9;  //  ISO Cyrillic;
  FCS_ISO_8859_6      = 10; //  ISO Arabic;
  FCS_ISO_8859_7      = 11; //  ISO Greek;
  FCS_ISO_8859_8      = 12; //  ISO Hebrew;
  FCS_ISO_8859_9      = 13; //  ISO Latin-5 (Turkish);
  FCS_ISO_8859_10     = 14; //  ISO Latin-6 (Nordic);
  FCS_ISO_8859_15     = 15; //  ISO Latin-9, or Latin-0 (Revised Western-European);
  FCS_koi8_r          = 16; //  KOI8 Russian;
  FCS_koi8_u          = 17; //  KOI8 Ukrainian (see RFC 2319);
  FCS_koi8_ru         = 18; //  KOI8 Russian/Ukrainian
  FCS_koi8_uni        = 19; //  KOI8 ``Unified'' (Russian, Ukrainian, and Byelorussian);
  //FCS_koi8_e          = 20; //  KOI8 ``European,'' ISO-IR-111, or ECMA-Cyrillic;

  MAC_CHARSET         = 77;
  SHIFTJIS_CHARSET    = 128;
  HANGEUL_CHARSET     = 129;
  JOHAB_CHARSET       = 130;
  GB2312_CHARSET      = 134;
  CHINESEBIG5_CHARSET = 136;
  GREEK_CHARSET       = 161;
  TURKISH_CHARSET     = 162;
  VIETNAMESE_CHARSET  = 163;
  HEBREW_CHARSET      = 177;
  ARABIC_CHARSET      = 178;
  BALTIC_CHARSET      = 186;
  RUSSIAN_CHARSET     = 204;
  THAI_CHARSET        = 222;
  EASTEUROPE_CHARSET  = 238;
  OEM_CHARSET         = 255;
  // additional charsets

//-----------
// Font Sets
//-----------
  FS_LATIN1 = 1;
  FS_LATIN2 = 2;
  FS_CYRILLIC = 4;
  FS_GREEK = 8;
  FS_TURKISH = $10;
  FS_HEBREW = $20;
  FS_ARABIC = $40;
  FS_BALTIC = $80;
  FS_VIETNAMESE = $00000100;
  FS_THAI = $10000;
  FS_JISJAPAN = $20000;
  FS_CHINESESIMP = $40000;
  FS_WANSUNG = $80000;
  FS_CHINESETRAD = $100000;
  FS_JOHAB = $200000;
  FS_SYMBOL = $80000000;
//end lcl
type

  { TGraphicsObject }

  TGraphicsObject = class(TPersistent)
  private
    FHandle: THandle;
    FOnChange: TNotifyEvent;
    procedure SetHandle(const AValue: THandle);
  protected
    FHandleOwned:boolean;
    FParent:TObject;
    procedure Changed;virtual;
    procedure UpdateHandle;virtual;
  public
    property OnChange:TNotifyEvent read FOnChange write FOnChange;
    property Handle:THandle read FHandle write SetHandle;
    constructor Create;virtual;
  end;
  TFontCharset = LongInt;
  TFontPitch = (fpDefault, fpVariable,fpFixed);
  { TFont }

  TFont = class(TGraphicsObject)
  private
    //FCanvas: TCanvas;
    FColor: TColor;
    FCharset: TFontCharset;
    FHeight: Integer;
    FName: string;
    FPitch: TFontPitch;
    FPixelsPerInch: integer;
    FStyle: TFontStyles;
    function GetCharset: TFontCharset;
    function GetSize: integer;
    procedure SetCharset(const AValue: TFontCharset);
    procedure SetColor(const AValue: TColor);
    procedure SetHandle(const AValue: THandle);
    procedure SetHeight(const AValue: Integer);
    procedure SetName(const AValue: string);
    procedure SetPitch(const AValue: TFontPitch);
    procedure SetPixelsPerInch(const AValue: integer);
    procedure SetSize(const AValue: integer);
    procedure SetStyle(const AValue: TFontStyles);
  protected
    procedure UpdateHandle;override;
  public
//    property DefCanvas:TCanvas read FCanvas write FCanvas;
    property PixelsPerInch:integer read FPixelsPerInch write SetPixelsPerInch default 96;
    procedure Assign(Source: TPersistent); override;
    constructor Create;override;
    Destructor Destroy;override;
  published
    property Charset:TFontCharset read GetCharset write SetCharset;
    property Color:TColor read FColor write SetColor;
    property Height:Integer read FHeight write SetHeight;
    property Size:integer read GetSize write SetSize;
    property Style:TFontStyles read FStyle write SetStyle;
    property Name:string read FName write SetName;
    property Pitch:TFontPitch read FPitch write SetPitch;
  end;

  { TPen }

  TPen = class(TGraphicsObject)
  private
    FColor: TColor;
    FMode: TPenMode;
    FStyle: TPenStyle;
    FWidth: integer;
    procedure SetColor(const AValue: TColor);
    procedure SetMode(const AValue: TPenMode);
    procedure SetStyle(const AValue: TPenStyle);
    procedure SetWidth(const AValue: integer);
  protected
    procedure UpdateHandle; override;
  public
  published
    property Style:TPenStyle read FStyle write SetStyle;
    property Color:TColor read FColor write SetColor;
    property Mode:TPenMode read FMode write SetMode;
    property Width:integer read FWidth write SetWidth;
  end;
  TGraphic=class
  private

  protected
    FEmpty: boolean;
    FModified: boolean;
    function GetHeight: integer;virtual;abstract;
    procedure SetHeight(const AValue: integer);virtual;abstract;
    function GetWidth: integer;virtual;abstract;
    procedure SetWidth(const AValue: integer);virtual;abstract;
  public
    property Empty:boolean read FEmpty;
    property Modified:boolean read FModified write FModified;
    property Width:integer read GetWidth write SetWidth;
    property Height:integer read GetHeight write SetHeight;
    constructor Create; virtual;
  end;

  TBitmap=class;


  { TBrush }

  TBrush=class(TGraphicsObject)
  private
    FBitmap: TBitmap;
    FColor: TColor;
    FStyle: TBrushStyle;
    procedure SetBitmap(const AValue: TBitmap);
    procedure SetColor(const AValue: TColor);
    procedure SetStyle(const AValue: TBrushStyle);
  public
    procedure UpdateHandle; override;
  published
    property Style:TBrushStyle read FStyle write SetStyle;
    property Color:TColor read FColor write SetColor;
  public
    property Bitmap:TBitmap read FBitmap write SetBitmap;
  end;


  { TBitmap }

  TBitmap=class(TGraphic)
  private
    function Getbpp: integer;
    function GetScanLine(i: integer): Pointer;
  protected
    FHandle:THandle;
    function GetHeight: integer; override;
    procedure SetHeight(const AValue: integer); override;
    function GetWidth: integer; override;
    procedure SetWidth(const AValue: integer); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    property Handle:THandle read FHandle;
    property bpp:integer read Getbpp;
    property ScanLine[i:integer]:Pointer read GetScanLine;
  end;

  { TCanvas }

  TCanvas=class(TPersistent)
  private
    FBackgroundColor: TColor;
    procedure SetBackgroundColor(AValue: TColor);
  protected
    FBrush: TBrush;
    FColor: TColor;
    OldX,OldY:integer;
    FFont: TFont;
    FHandle: THandle;
    FPen: TPen;
    FGot:THandle;
    FCreated:Boolean;
    function GetPixels(x, y: integer): TColor;
    procedure SetBrush(AValue: TBrush);
    procedure SetColor(AValue: TColor);
    procedure SetFont(AValue: TFont);
    procedure SetPen(AValue: TPen);
    procedure SetPixels(x, y: integer; AValue: TColor);
  public
    property Pixels[x,y:integer]:TColor read GetPixels write SetPixels;
    property Handle:THandle read FHandle;
    constructor Create;virtual;
    Destructor Destroy; override;
    procedure TextOut(X,Y:integer;const Txt:String);
    procedure LineTo(X,Y:integer);
    procedure MoveTo(X,Y:integer);
    procedure Rectangle(x1,y1,x2,y2:integer);
    procedure FilledRectangle(x1,y1,x2,y2:integer);
    procedure ActualizeWin(WindowHandle:THandle);
    procedure ActualizeMem;
  published
    property Brush:TBrush read FBrush write SetBrush;
    property Pen:TPen read FPen write SetPen;
    property Font:TFont read FFont write SetFont;
    property Color:TColor read FColor write SetColor default 0;
    property BackgroundColor:TColor read FBackgroundColor write SetBackgroundColor;
  end;



var
  AllWnds:TList;
  XWinDisplay:pointer;//Nothing in Windows
//Skin. To be set, just set this procedure - and do all the things
//SkinProc must take the a control, draw it if can, and return true.
//If cannot, or if default behaviour, it should return false.

type TSkinProc = function(Sender:TObject):boolean;
{$ifdef oldver}
const
{$else}
var
{$endif}
  SkinProc:TSkinProc = nil;

function Skin(sender:TObject):boolean;
implementation


{$ifdef win}
{$i mgraphwin.inc}
{$endif}
{$ifdef unix}
{$i mgraphunx.inc}
{$endif}

function Skin(sender:TObject):boolean;
begin
  Result:=false;
  if not Assigned(SkinProc) then exit;
  Result:=SkinProc(sender);
end;

//Here is only platform-independent code
{ TCanvas }

constructor TCanvas.Create;
begin
  inherited Create;
  FHandle:=0;
  FGot:=0;
  FCreated:=false;
  FPen:=TPen.Create;
  FPen.FParent:=self;
  FBrush:=TBrush.Create;
  FBrush.FParent:=self;
end;




{ TGraphic }

constructor TGraphic.Create;
begin
  inherited Create;
  FEmpty:=true;
end;

{ TBrush }

procedure TBrush.SetBitmap(const AValue: TBitmap);
begin
  if FBitmap=AValue then exit;
  FBitmap:=AValue;
  Changed;
end;

procedure TBrush.SetColor(const AValue: TColor);
begin
  if FColor=AValue then exit;
  FColor:=AValue;
  Changed;
end;

procedure TBrush.SetStyle(const AValue: TBrushStyle);
begin
  if FStyle=AValue then exit;
  FStyle:=AValue;
  Changed;
end;


{ TPen }

procedure TPen.SetColor(const AValue: TColor);
begin
  if FColor=AValue then exit;
  FColor:=AValue;
  Changed;
end;

procedure TPen.SetMode(const AValue: TPenMode);
begin
  if FMode=AValue then exit;
  FMode:=AValue;
  Changed;
end;

procedure TPen.SetStyle(const AValue: TPenStyle);
begin
  if FStyle=AValue then exit;
  FStyle:=AValue;
  Changed;
end;

procedure TPen.SetWidth(const AValue: integer);
begin
  if FWidth=AValue then exit;
  FWidth:=AValue;
  Changed;
end;



{ TFont }

function TFont.GetCharset: TFontCharset;
begin
  //TODO, now assuming this to be system deal
  Result:=FCharset;
end;

function TFont.GetSize: integer;
begin
  Result:=-Height*72 div PixelsPerInch;
end;

procedure TFont.SetCharset(const AValue: TFontCharset);
begin
  //todo
  if AValue=FCharset then exit;
  FCharset:=AValue;
  Changed;
end;

procedure TFont.SetColor(const AValue: TColor);
begin
  if FColor=AValue then exit;
  FColor:=AValue;
  Changed;
end;

procedure TFont.SetHandle(const AValue: THandle);
begin
  if FHandle=AValue then exit;
  FHandle:=AValue;
  Changed;
end;

procedure TFont.SetHeight(const AValue: Integer);
begin
  if FHeight=AValue then exit;
  FHeight:=AValue;
  Changed;
end;

procedure TFont.SetName(const AValue: string);
begin
  if FName=AValue then exit;
  FName:=AValue;
  Changed;
end;

procedure TFont.SetPitch(const AValue: TFontPitch);
begin
  if FPitch=AValue then exit;
  FPitch:=AValue;
  Changed;
end;

procedure TFont.SetPixelsPerInch(const AValue: integer);
begin
  if FPixelsPerInch=AValue then exit;
  FPixelsPerInch:=AValue;
  Changed;
end;

procedure TFont.SetSize(const AValue: integer);
begin
  Height:=-AValue*PixelsPerInch div 72;
end;

procedure TFont.SetStyle(const AValue: TFontStyles);
begin
  if FStyle=AValue then exit;
  FStyle:=AValue;
  Changed;
end;




procedure TFont.Assign(Source: TPersistent);
var FNT:TFont;
begin
  inherited Assign(Source);
  if not (Source is TFont) then exit;
  FNT:=Source as TFont;
  FCharset:=FNT.Charset;
  FColor:=FNT.Color;
  FHeight:=FNT.Height;
  FName:=FNT.FName;
  FPitch:=FNT.Pitch;
  FPixelsPerInch:=FNT.PixelsPerInch;
  Changed;
end;

constructor TFont.Create;
begin
  inherited Create;
  Handle:=0;
end;




{ TGraphicsObject }

procedure TGraphicsObject.SetHandle(const AValue: THandle);
begin
  if FHandle=AValue then exit;
  FHandle:=AValue; //Assigned, but not OWNED!
  FHandleOwned:=false;
end;

procedure TGraphicsObject.Changed;
begin
  UpdateHandle;
  if assigned(FOnChange) then FOnChange(self);
end;

procedure TGraphicsObject.UpdateHandle;
begin
  //Nothing here
end;

constructor TGraphicsObject.Create;
begin
  inherited Create;
  FHandleOwned:=false;
  FParent:=nil;
end;

initialization
  AllWnds:=TList.Create;
  PrepareGraph;
finalization
  AllWnds.Free;
  FinalGraph;
end.

